parse arg opts;options cache;options failat 99;options results;signal on break_c;signal on break_d;signal on break_e;signal on break_f;signal on halt;signal on ioerr;signal on syntax;address 'MAILMANAGER';Main:;call Init;call Header;call Parse_Args(opts);call Get_SystemDatas();call Read_Cfg(0);call pragma('p',system.taskpri);call Wait_AreasWindow;call Check_NodeList;do n=0 to system.mtrx.count-1;call Process_Msgs(system.mtrx.area.n,system.mtrx.addr.n);end;if system.cse.count>1 then call Bounce_SplitEncoded;call Clean_Up;call Quit(0,'All done.');exit;Add_CheckSplitEncoded: procedure Expose msg. system.;parse arg areatag,nr,size;last=system.cse.count-1;s='a'x;check=upper(msg.data.from||s||msg.data.fromaddr||s||msg.data.to||s||msg.data.toaddr);if last>-1 then if system.cse.data.last~=check then do;system.cse.area.count=0;system.cse.msg.count=0;system.cse.data.count=0;end;MM_AddToStem 'system.cse.area' 'areatag';MM_AddToStem 'system.cse.msg' 'nr';MM_AddToStem 'system.cse.data' 'check'
system.cse.count=system.cse.area.count;return;Add_Clean: procedure Expose system.;arg area;if find(system.clean,area)>0 then return;system.clean=system.clean area;MM_AddToStem 'system.clean' 'area';return;Add_Clip: procedure;arg area .;tmp=getclip('MM_EXPORT');if find(tmp,area)=0 then call setclip('MM_EXPORT',tmp area);return;Add_Found: procedure Expose found. system.;parse arg line;if index(found.check,line'a'x)>0 then return 0;MM_AddToStem 'found' 'line';found.check=found.check line'a'x;return 0;Add_Kludge: procedure Expose msg. system. write.;parse arg type,kludge;stem.0='msg.data.';stem.1='write.';tmp='1'x||kludge;MM_AddToStem stem.type'head' 'tmp';return;Add_Log: procedure Expose msg. system.;parse arg pfx.1,text.1,pfx.2,text.2;if text.1=''&text.2~='' then do;pfx.1=pfx.2;pfx.2='';text.1=text.2;text.2='';end;if text.1~='' then do;do n=1 to 2;if pfx.n~='' then pfx.n=overlay(pfx.n,system.log.prefix);else pfx.n=system.log.etypfx;end;text=pfx.1||text.1
if text.2~='' then text=left(text,(system.log.linelen%2)-1) pfx.2||text.2;end;MM_AddToStem 'msg.log' 'text';return;Add_Stat: procedure Expose statistic.;parse arg text,num .;if num~='' then text=overlay(' 'text' ',' ......................:') right(num,5);MM_AddToStem 'statistic' 'text';return;Add_Status: procedure Expose msg.;parse arg line;MM_AddToStem 'msg.status' 'line';return;Add_Via: procedure Expose msg. system.;arg stem;tmp='1'x'Via' system.addr delstr(date(),8,2)' 'time() '('system.prg.fid')';MM_AddToStem stem 'tmp';return;Add_Write: procedure Expose write.;parse arg text;MM_AddToStem 'write.text' 'text';return;Adjust_Addresses: procedure Expose domain. msg. system.;from_addr=Check_Addr(msg.data.fromaddr);to_addr=Check_Addr(msg.data.toaddr);adj=0;if from_addr~='' then if upper(msg.data.fromaddr)~=upper(from_addr) then do;msg.data.fromaddr=from_addr;call Set_MsgChanged;end;if to_addr~='' then if upper(msg.data.toaddr)~=upper(to_addr) then do;msg.data.toaddr=to_addr;call Set_MsgChanged;end;return
Adjust_Kludges: procedure Expose msg. system.;new.=0;do n=0 to msg.data.head.count-1;parse value upper(msg.data.head.n) with . 2 kludge .;if find(system.rmkludges,kludge)=0 then MM_AddToStem 'new' 'msg.data.head.'n;end;if msg.data.head.count~=new.count then do;call Drop_SubStem('msg.data.head');do n=0 to new.count-1;msg.data.head.n=new.n;end;msg.data.head.count=new.count;end;return;Analyse_Kludges: procedure Expose msg. domain. system.;msg.data.kludge.reply=Get_Kludge('MSGID:','1'x'REPLY:');msg.data.replyaddr=Get_Kludge('REPLYADDR','To:');tmp=Get_Kludge('REPLYTO');if tmp~='' then do;parse var tmp check name;address=Check_Addr(check);if address='' then break;msg.data.fromaddr=address;name=strip(name);if name~='' then msg.data.from=name;end;msg.data.kludges=1;return;BaseName: procedure;parse arg file;return substr(file,max(lastpos(':',file),lastpos('/',file))+1);Both_Unknown: procedure Expose msg. system.;parse arg area,nr;call Log(' UNKKNOWN SOURCE & DESTINATION!!!')
call Count_Stat(ukind);return ret;break_c:;break_d:;break_e:;break_f:;halt:;signal off break_c;signal off break_d;signal off break_e;signal off break_f;signal off halt;return_code=5;error_line=0;error_msg='Execution halted!!!';rc=0;signal Exit;Check_Addr: procedure Expose domain. system.;parse arg check,mode;parse value strip(check,'b','. ') with zone ':' net '/' node '@' dmn '.' .;parse var node node '.' point .;if point='' then point=0;if ~datatype(zone,'N')|~datatype(net,'N')|~datatype(node,'N')|~datatype(point,'N') |zone=0|net=0 then return '';if mode~='NOADJ' then do;tmp=system.domain;if domain=''|domain.tmp.adjust|mode='ADJUST' then dmn=Get_Domain(check);end;else;if dmn=''|find(system.vdomains,Make_Valid(dmn))=0 then return '';return zone':'net'/'node'.'point'@'dmn;Check_Address: procedure Expose domain. msg. system.;arg mode,addr . 1 zone . ':' .;node=mode'NODE';real=mode'ADDR';tmp=mode'DOMAIN';dmn=msg.data.tmp;if find(system.addresses,msg.data.node)>0 then
return find(system.addresses system.nodes,upper(msg.data.real))=0;if find(system.nodes,msg.data.node)>0 then return 0;if domain.dmn.zones~=''&domain.dmn.bounce.wrongaddr then if find(domain.dmn.zones,zone)=0|dmn=system.baddomain then return 1;if ~domain.dmn.bounce.unkndst then return 0;MM_GetNodelistNode msg.data.node 'tmp';ret=rc;if ret=0 then return 0;if ret=5 then do;call Log('*** INFO: Unable to access nodelist(s)!!!');return 0;end;return 1;Check_AllowEncoded: procedure Expose domain. msg. system.;parse arg dmn;if ~domain.dmn.fkt.allowenc then return 0;enc.0='FROM';enc.1='TO';do n=0 to 1;typ=enc.n;field=typ'ADDR';do m=0 to domain.dmn.encoded.typ.count-1;if Check_Pattern(domain.dmn.encoded.typ.m,msg.data.field) then return 1;end;end;return 0;Check_CrossNet: procedure Expose msg. domain.;parse arg dmn;if msg.data.fromdomain~=msg.data.todomain then return 1+domain.dmn.bounce.crossnet;return 0;Check_Empty: procedure Expose domain. msg. system.;arg dmn,address
if ~domain.dmn.delete.empty|~msg.system then return 0;check=0;tear=0;do n=0 to msg.data.text.count-1 while ~(check|tear);parse var msg.data.text.n first .;tear=first='---';check=strip(msg.data.text.n)~=''&~tear;end;return check=0;Check_Encoded: procedure Expose domain. msg. system.;arg area,nr,dmn,msgsize;if msg.system|msg.link then return '';if domain.dmn.encoded.size=0 then return '';check_split=find(domain.dmn.encoded.mode,'SPLIT')>0;if msgsize<domain.dmn.encoded.size&~check_split then return '';enc=0;enc_len=0;do n=msg.data.text.count-1 to 0 by-1;len=length(msg.data.text.n);check=len-(len-length(compress(msg.data.text.n)))-lastpos(' ',msg.data.text.n);if last_len~=check then cnt=0;last_len=len;if len<50 then iterate;if cnt>0 then enc_len=enc_len+last_len;cnt=cnt+1;if cnt<max(domain.dmn.encoded.size%len,10) then iterate;enc=1;leave;end;if enc|(~enc&check_split) then allowed=~enc|Check_AllowEncoded(dmn);else allowed=1;if ~enc&~allowed&check_split then call Add_CheckSplitEncoded(area,nr,enc_len)
if allowed then ret='';else ret='*' domain.dmn.encoded.mode;return ret;Check_FATT: procedure Expose msg. domain. rc. system.;arg dmn;if ~domain.dmn.fatt then return 0;if find(msg.data.flags,'FATT')=0 then return 0;if msg.sysop then return 1;if msg.system|msg.link then return 2;return 3;Check_Function: procedure Expose domain. msg. rc. system.;arg function;ret=Check_Matching_Pattern(function,msg.data.from,msg.data.fromaddr,msg.data.subj) Check_Matching_Pattern(function,msg.data.to,msg.data.toaddr,msg.data.subj);return Set_RC(function,strip(ret));Check_Hex: procedure;arg hex hash .,len;return hex~=''&datatype(hex,'X')&length(hex)=len&d2x(hash(hex))=hash;Check_Kill: procedure Expose msg. system.;if ~system.fkt.kill|~msg.sysop then return '';return Check_Matching_Pattern('KILL',msg.data.from,msg.data.fromaddr,msg.data.subj);Check_Loop: procedure Expose domain. msg. system.;arg check,area,nr;if ~check then return 0;check.=0;last_addr='';do n=0 to msg.data.foot.count-1
if compress(msg.data.foot.n,'010D'x)='' then iterate;addr=upper(Get_Addr_From_Via(msg.data.foot.n));select;when addr='???' then nop;when check.addr&last_addr~=addr&find(system.addresses,addr)>0 then return 1;otherwise;do;check.addr=1;last_addr=addr;end;end;end;return 0;Check_Matching_Pattern: procedure Expose msg. system.;arg type,stem.name.0,stem.addr.0,stem.subj.0;if system.fkt.np.type then do n=0 to system.check.count-1;field=system.check.n;stem.field.count=1;do m=0 to system.type.field.ptrn.count-1;result.=0;MM_SearchInStem 'stem.'field 'result' system.type.field.ptrn.m 'STR';if result.count>0 then return system.type.field.mode.m;end;end;if system.fkt.fp.type then do n=0 to system.ptrn.type.from.count-1;cnt=0;stem.count=1;do m=0 to system.full_check.count-1;result.=0;field=system.full_check.m;stem.0=msg.data.field;MM_SearchInStem 'stem' 'result' '"'system.ptrn.type.field.n'"' 'NUM';cnt=cnt+(result.count>0);end;if cnt=system.full_check.count then return system.ptrn.type.mode.n;end;return ''
Check_NodeList: procedure Expose system.;check=Get_Node(system.addresses.0);tmp='Unable to access nodelist(s)!!!';do n=0 to 5;MM_GetNodelistNode check 'tmp';err=RC>0;if ~err then leave;call Log('*** WARNING:' tmp '('check 'not found)');call Log(' 'n'> Waiting 30 seconds...');call delay(30*50);end;if err then do;if system.cplnl~=0 then do;call Log(' ==>> Compiling nodelists!');call Command(system.cplnl);MM_GetNodelistNode check 'tmp';err=RC>0;end;if err then call Quit(24,tmp);end;return;Check_Pattern: procedure Expose result;arg pattern,string.0;string.count=1;result.=0;MM_SearchInStem 'string' 'result' '"'pattern'"' 'STR';result=result.0;return result.count>0;Check_Processed: procedure Expose domain. system.;system.stat.ucnt=system.stat.ucnt+1;last_check=system.stat.uchk;system.stat.uchk=12+left(date('u'),2);tmp=date('i')-system.stat.uday;if system.stat.uchk=last_check|tmp<30|datatype(substr(system.prg.state,2),'N') then return
call Msg_Head('4E6F74696669636174696F6E2061626F757420746865207573616765206F66'x system.prg.fid);call Get_SystemInfo();call Notify_Author('5573616765206F66'x system.prg.name);return;Check_Robot: procedure Expose msg. system.;if ~msg.sysop then return 0;arg to;do n=0 to system.robot.name.ptrn.count-1;if Check_Pattern(system.robot.name.ptrn.n,to) then return 1;end;return 0;Check_RRR: procedure Expose domain. msg. system.;arg dmn;if find(msg.data.flags,'RRR')=0 then return 0;if domain.dmn.rrr.system then if msg.sysop then return 1;if domain.dmn.rrr.points then if find(system.addresses,upper(msg.data.tonode))>0 then return 1;return 0;Check_Twit: procedure Expose domain. msg. rc. system.;if msg.sysop then return '';return Check_Function('TWIT');Clean_Up:;if ~system.nostats&system.stats then call Write_Stats;if system.export.count=0&system.clean.count>0 then do n=0 to system.clean.count-1;MM_CleanArea system.clean.n;end;do n=0 to system.export.count-1;MM_Export system.export.n;MM_Delete system.export.n
parse var tmp_r msgfile tmp_r;cmd=strip(strip(tmp_l) strip(tmp_r));MM_WriteStem msgfile 'msg.data.head';MM_WriteStem msgfile 'msg.data.text' 'APPEND';MM_WriteStem msgfile 'msg.data.foot' 'APPEND';end;call Log(' Executing "'cmd'".',,3);ret=Command(cmd);select;when ret=0 then nop;when ret=1 then call Set_RC('KILL',rc.kill 'BOUNCE MOVE');when ret=2 then call Set_RC('TWIT',rc.twit 'BOUNCE MOVE');otherwise call Set_RC('EXCLUDE','*');end;end;return;Exit:;if return_code>29 then call Report_Error(return_code,error,error_msg);select;when return_code>=40 then error='INTERNAL-ERROR:';when return_code>=30 then error='IO-ERROR:';when return_code>=20 then error='ERROR:';when return_code>=10 then error='CFG-ERROR:';when return_code>=5 then error='INFO:';otherwise error='';end;txt='***' strip(error error_msg) '***';if return_code>5 then say system.prg.name':' txt;call Log(,,3);call Log(txt,'+');call Log(,'\',3);call setclip('MM_LogPre',system.mm.logpre);exit return_code;Format_Log: procedure Expose msg. system.
parse arg pfx,text;text=strip(text);if text='' then do;call Add_Log(pfx);return;end;if length(word(text,1))>system.log.txtlen then do;tmp=substr(text,system.log.txtlen+1);text=strip(left(text,system.log.txtlen));call Add_Log(pfx,text);call Format_Log('',tmp);return;end;tlen=length(text);if tlen>system.log.txtlen then do;lsp=lastpos(' ',text,system.log.txtlen);tmp=substr(text,lsp);text=strip(left(text,lsp-1));call Add_Log(pfx,text);call Format_Log('',tmp);end;else call Add_Log(pfx,text);return;Forward: procedure Expose domain. msg. rc. system.;parse arg mtrx,nr;call Get_FunctionDatas('FORWARD');do n=0 to found.count-1;parse value translate(found.n,'2227'x,'FEFF'x) with to.area '¡' to.name '¡' to.addr '¡' to.subj '¡' to.flags '¡' delmsg;if to.area='%ma' then to.area=mtrx;call Log(' Forwarding mail from' msg.data.from 'to' to.area',' to.name||strip(',' to.addr,'t',', ')'...');MM_GetAreaInfo to.area 'tmp';if tmp.type='MAIL' then lang=msg.data.tolang;else lang=Get_Language(tmp.addr)
call Forward_Msg('Forward',lang,to.area,strip(to.name),to.addr, Replace_Embedded(strip(to.subj)),to.flags,0);call Add_Clip(to.area);if delmsg then do;MM_DeleteMsg mtrx nr;call Log(' -> Original msg deleted!');end;end;return delmsg;Forward_Msg: procedure Expose domain. msg. system. write.;parse arg file,language,area,dst,dstaddr,subject,flags,is_reply;if file~='Forward' then do;tmp=Get_Node(dstaddr);MM_GetNodelistNode tmp 'tmp';if RC~=0 then do;call Log(' *** Unknown destination-address' dstaddr', unable to forward mail!');return;end;dst=Get_Sysop(dst,dstaddr);call Log(' Sending mail to' dst',' dstaddr,,3);end;subject=Replace_Embedded(subject);textfile=Read_File(file,language);write.=0;if is_reply then do;if ~msg.data.kludges then call Analyse_Kludges;if msg.data.replyaddr~='' then MM_AddToStem 'write.addtxt' 'msg.data.replyaddr';MM_AddToStem 'write.head' 'msg.data.kludge.reply';end;do n=0 to txt.count-1;tmp=Replace_Embedded(txt.n);if index(tmp,'%T')=0 then call Add_Write(tmp);else;do
parse var tmp . '%T' lines .;if lines=''|lines=msg.data.text.count then lines=msg.data.text.count;else;do;if ~datatype(lines,'N') then do;lines=20;call Log('*** WARNING: Numeric value expected after %T in' textfile 'at line' n'!!!');call Log(' -> Using default (='lines') instead.',,4);end;call Cut_Text(lines);end;do m=0 to msg.data.head.count-1;tmp=strip(translate(msg.data.head.m,'@','010D'x));if tmp~='' then call Add_Write(tmp);end;if msg.data.head.count>0 then call Add_Write();do m=0 to msg.data.text.count-1;call Add_Write(msg.data.text.m);end;do m=0 to msg.data.foot.count-1;tmp=strip(translate(msg.data.foot.m,'@','010D'x));if tmp~='' then call Add_Write(tmp);end;end;end;call Write_Msg('write',area,dst,dstaddr,subject,system.tmpfile,flags);return;Get_Addr_From_Via: procedure Expose domain. system.;parse arg . tmp;tmp=compress(tmp,'010D'x',"');do while tmp>'';parse var tmp check tmp;address=Check_Addr(check);if address~='' then return address;end;return '???'
Get_AddrDomain: procedure Expose system.;arg .'@' domain '.' .;return Make_Valid(domain);Get_Arg: procedure Expose args;arg keyword,rnr;p=find(upper(args),keyword);ret=0;if rnr>0 then if p>0 then do;ret=subword(args,p+1,rnr);args=delword(args,p,p+rnr);end;else ret='';else;if p>0 then do;ret=1;args=delword(args,p,1);end;args=strip(args);return ret;Get_Domain: procedure Expose domain. system.;arg zone . ':' .;l_tmp=system.domains;u_tmp=system.vdomains;do while u_tmp~='';parse var l_tmp l_dmn l_tmp;parse var u_tmp u_dmn u_tmp;if find(domain.u_dmn.zones,zone)>0 then return l_dmn;end;parse var system.badaddr . '@' dmn '.' .;return dmn;Get_FunctionDatas: procedure Expose found. msg. system.;parse arg function;field.1='FROM';field.2='TO';found.=0;found.check='';stem.subj.0=msg.data.subj;do i=1 to 2;tmp=field.i;tmp2=tmp'ADDR';stem.name.0=msg.data.tmp;stem.addr.0=msg.data.tmp2;do n=0 to system.check.count-1;field=system.check.n;stem.field.count=1;do m=0 to system.function.field.ptrn.count-1;result.=0
MM_SearchInStem 'stem.'field 'result' system.function.field.ptrn.m 'STR';if result.count>0 then call Add_Found(system.function.field.mode.m);end;end;do n=0 to system.ptrn.function.from.count-1;cnt=0;stem.count=1;do m=0 to system.full_check.count-1;result.=0;field=system.full_check.m;stem.0=msg.data.field;MM_SearchInStem 'stem' 'result' '"'system.ptrn.function.field.n'"' 'NUM';cnt=cnt+(result.count>0);end;if cnt=system.full_check.count then cnt=Add_Found(system.ptrn.function.mode.n);end;end;return;Get_Kludge: procedure Expose msg. system.;arg kludge,new_id;result.=0;result.0='';MM_SearchInStem 'msg.data.head' 'result' '"?'kludge' #?"' 'STR';parse var result.0 . ret;ret=strip(ret);if ret~='' then ret=strip(new_id ret);return ret;Get_Language: procedure Expose system.;parse arg tmp_stem.0;tmp_stem.count=1;result.=0;do n=0 to system.lang.known.count-1;tmp=system.lang.known.n;do m=0 to system.lang.ptrn.tmp.count-1;MM_SearchInStem 'tmp_stem' 'result' system.lang.ptrn.tmp.m 'STR';if result.count>0 then return tmp
end;end;return '';Get_Name: procedure;parse arg address;MM_GetNodelistNode address 'tmp';if rc>0 then ret='Sysop';else ret=tmp.sysop;return ret;Get_Node: procedure;parse arg left '.' . '@' right;return left'.0@'right;Get_Nodelists: procedure Expose system.;system.nodelists='<Nodelist not available>';if Command(system.shownl '>'system.tmpfile)>0 then return;MM_ReadStem system.tmpfile 'tmp2';if rc>0 then return;tmp.=0;do n=1 to tmp2.count-1;MM_AddToStem 'tmp' 'tmp2.'n;end;MM_SortStem 'tmp';system.nodelists='';do n=0 to tmp.count-1;system.nodelists=system.nodelists strip(translate(tmp.n,' ','9'x))',';end;system.nodelists=upper(strip(system.nodelists,'b',', '));call delete(system.tmpfile);return;Get_Sysop: procedure;parse arg name,address;if index(address,'.0@')=0 then return name;return Get_Name(address);Get_SystemDatas: procedure Expose system.;MM_GetSysop 'system.sysop';parse var system.sysop system.sysop_first system.sysop_sur;MM_GetNodes 'system.nodes';do n=0 to system.nodes.count-1
system.log.linelen=80;system.log.prelen=11;system.log.txtlen=system.log.linelen-system.log.prelen;system.log.prefix=copies('.',system.log.prelen-2)': ';system.log.etypfx=copies(' ',system.log.prelen);system.check.0='NAME';system.check.1='ADDR';system.check.2='SUBJ';system.check.count=3;system.full_check.0='FROM';system.full_check.1='FROMADDR';system.full_check.2='TO';system.full_check.3='TOADDR';system.full_check.4='SUBJ';system.full_check.count=5;call Include_Lib('rexxsupport');return;Include_Lib: procedure Expose system.;parse arg lib,prio;if right(upper(lib),8)~='.LIBRARY' then lib=lib'.library';if prio='' then prio=0;if ~show('l',lib) then if ~addlib(lib,prio,-30,0) then call Quit(20,'Could not open' lib'!!!');return;Insert_Text: procedure Expose msg. system.;parse arg file,language;call Read_File(file,language);do n=0 to txt.count-1;MM_AddToStem 'msg.data.addtxt' 'txt.'n;end;return;IOerr:;signal off ioerr;return_code=30;error_code=rc;error_line=sigl
error_msg='IO-error' rc 'at line' error_line '['errortext(rc)']');rc=0;signal Exit;Log: procedure Expose system.;parse arg text,pre,level;if ~datatype(level,'N') then level=system.prg.loglevel;tmp=word('PRG MM',(pre~='')+1);text=system.tmp.logpre||pre' 'text;MM_WriteLog 'text' level;return;Log_Msg: procedure Expose domain. msg. system.;arg dmn;if domain.dmn.log.file=0|pos('of' system.prg.name,msg.data.subj)>0 then return;call Add_Log('Imported',date()' 'time(),'Created',msg.data.datum msg.data.time);call Add_Log('From User',msg.data.from,'From Addr',msg.data.fromaddr);call Add_Log('To User',msg.data.to,'To Addr',msg.data.toaddr);if domain.dmn.log.size then msg_size=msg.data.text.size 'bytes';else msg_size='';if domain.dmn.log.flags then do;msg_flags='';tmp=msg.data.origflags;do while tmp>'';parse var tmp check tmp;if find('PVT CRASH HOLD RRR FATT',check)=0 then iterate;msg_flags=msg_flags check;end;msg_flags=strip(msg_flags);if msg_flags='' then msg_flags='<none>';end;else msg_flags=''
if domain.dmn.log.size|domain.dmn.log.flags then call Add_Log('Size',msg_size,'Flags',msg_flags);if domain.dmn.log.subj then call Format_Log('Subject',msg.data.subj);if domain.dmn.log.routing then do;tmp=msg.data.foot.count-1;do tmp=tmp to 0 by-1 while strip(msg.data.foot.tmp,'b','010D'x' ')='';end;from=Get_Addr_From_Via(msg.data.foot.tmp);if from='???' then if find(msg.data.origflags,'CRASH')>0 then from=msg.data.fromaddr;call Add_Log('Routing','from' from);end;tmp.via='Via';tmp.np='<no via-lines present>';if domain.dmn.log.via.all then if msg.data.foot.count=0 then call Add_Log(tmp.via,tmp.np);else;do n=0 to msg.data.foot.count-1;tmp.line=subword(strip(msg.data.foot.n,'b','010D'x' '),2);if tmp.line='' then iterate;call Add_Log(tmp.via,tmp.line);tmp.via='';end;if domain.dmn.log.via.addr then if msg.data.foot.count=0 then call Add_Log(tmp.via,tmp.np);else;do;tmp='';do n=0 to msg.data.foot.count-1;tmp.line=strip(msg.data.foot.n,'b','010D'x' ');if tmp.line='' then iterate;address=Get_Addr_From_Via(tmp.line)
if find(upper(tmp),upper(address))=0 then tmp=tmp address;end;if tmp~='' then call Format_Log(tmp.via,strip(tmp));end;call Format_Log('Status',msg.status.0);do n=1 to msg.status.count-1;call Format_Log(,msg.status.n);end;call Add_Log();call Add_Log();tmp=domain.dmn.log.file;if pos('%d',tmp)>0 then tmp=replace(tmp,translate(date('o'),'-','/'),'%d');call Log(' Writing log "'tmp'".',,4);MM_WriteStem tmp 'msg.log' 'APPEND';if rc>0 then call Log('*** WARNING: Unable to write file "'tmp'"!!!');return;Msg_Head: procedure Expose system. write.;parse arg text;write.=0;call Add_Write();call Add_Write();call Add_Write(' 'text);call Add_Write(' 'copies('-',length(text)));call Add_Write();call Add_Write();return;Move_File: procedure Expose system.;parse arg from,to;if exists(to) then MM_MoveFile to to;MM_MoveFile from to;if RC=0 then call Log(' -> File "'from'" moved to "'to'".',,3);else;do;call Log('*** IO-ERROR: Unable to move "'from"' to '"to'"!');to=from;end;return to
if txt~='' then tmp.subj='['txt']' tmp.subj;MM_EditMsg old_area nr 'tmp';MM_MoveMsg old_area nr new_area;msg.subj=subjbak;end;MM_DeleteMsg old_area nr;call Log(' Moved old msg #'nr 'to' new_area'.',,3);return;Notify_Author: procedure Expose domain. msg. system. write.;parse arg subject;a.0='526F6265727420486F666D616E6E'x;a.1='33393A3137312F3130312E3140416D6967614E6574'x;a.2='323A323439302F313031352E31404669646F4E6574'x;select;when pos('414D4947414E4554'x,system.addresses)>0 then t=1;when pos('4649444F4E4554'x,system.addresses)>0 then t=2;otherwise return;end;tmp=Get_AddrDomain(a.t);tmp=word('KILL',domain.tmp.delete.own=1);call Write_Msg('write',system.mtrx.area.0,a.0,a.t,subject,system.tmpfile,tmp);return;Parse_Args: procedure Expose system.;arg args;system.forcecpl=Get_Arg('CPLCFG',0);if args~='' then signal Usage;return;Parse_MsgDatas: procedure Expose msg. system.;arg mode;parse var msg.data.from msg.data.from_first msg.data.from_sur;parse var msg.data.to msg.data.to_first msg.data.to_sur
MM_SearchMsgs area 'msgs' '#?' '#?' '#?' 'IMP' '!SENT';if RC=4 then do;call Log('*** ERROR: Unknown area "'area'"! ***',,0);return;end;call Log(' ' msgs.count 'msgs to process.',,3);if msgs.count=0 then return;call Add_Clip(area);parse var system.addr . '@' system.domain .;system.domain=Make_Valid(system.domain);system.exp=1;upper area;if ~system.nostats&~system.stats then call Read_Stats;if msgs.count>0 then call Add_Clean(area);do n=0 to msgs.count-1;rc.=0;rc.kill='';rc.twit='';rc.encoded='';admn=Read_Msg(area,msgs.n);call Log(' Processing msg #'msgs.n 'from' msg.data.fromaddr 'to' msg.data.toaddr);call Count_Stat('PROCESSED');if Set_RC('ROBOT',Check_Robot(msg.data.to)) then do;call Log(' Msg by' msg.data.from 'is for' msg.data.to', skipped.');call Count_Stat('NTD');iterate n;end;if Set_RC('EMPTY',Check_Empty(admn,msg.data.toaddr)) then do;call Log(' Msg by' msg.data.from 'is empty, deleted.');MM_DeleteMsg area msgs.n;call Count_Stat('EMPTY');iterate n;end
if Check_Function('EXECUTE')~='' then call Execute_Cmd(area,msgs.n);if Check_Function('FORWARD')~='' then if Forward(area,msgs.n) then iterate;select;when Set_RC('KILL',Check_Kill())~='' then call Bounce_Twit('Kill',area,msgs.n,rc.kill);when Set_RC('TWIT',Check_Twit())~='' then call Bounce_Twit('Twit',area,msgs.n,rc.twit);when Set_RC('ENCODED',Check_Encoded(area,msgs.n,admn,msg.data.text.size))~='' then call Bounce_Twit('Encoded',area,msgs.n,rc.encoded);when Check_Function('EXCLUDE')~='' then do;call Log(' Msg by' msg.data.from 'to' msg.data.to 'found in exclude-list, skipped.');call Count_Stat('EXCLUDE');end;otherwise;do;call Set_RC('REMAPFROM',Remap('FROM',msg.data.fromaddr,msg.data.from,area));call Set_RC('REMAPTO',Remap('TO',msg.data.toaddr,msg.data.to,area));if Set_RC('SRC',Check_Address('FROM',msg.data.fromaddr))| Set_RC('DST',Check_Address('TO',msg.data.toaddr)) then if system.nodelists=0 then call Get_Nodelists();select;when rc.src&rc.dst then call Both_Unknown(area,msgs.n)
when rc.dst then call Bounce_Mail(area,msgs.n);when rc.src then call Unknown_Sender(area,msgs.n,rc.encoded);when Set_RC('CROSSNET',Check_CrossNet(admn))>0 then call Cross_Net(area,msgs.n,rc.crossnet,rc.src);when Set_RC('LOOP',Check_Loop(domain.admn.loop,area,msgs.n)) then call Stop_Loop(area,msgs.n,rc.src);otherwise;do;if Set_RC('FATT',Check_FATT(admn,msg.data.flags))=3 then call Stop_FATT(area,msgs.n,admn);if Set_RC('RRR',Check_RRR(admn)) then call Send_Receipt(area,msgs.n);if ~msg.sysop then MM_AddToStem 'system.delete.'area 'msgs.'n;if rc.fatt>0 then do;own=rc.fatt=1;if words(msg.data.subj)>1 then call Route_Multiple_FATT(area,admn,msg.data.subj,own);call Move_FATT(area,admn,own);end;call Log(' Msg ok.');if rc.remapfrom+rc.remapto+rc.rrr+(rc.fatt~=3)=0 then call Count_Stat('NTD');call Count_Stat('SIZE',(msg.data.text.size+512)%1024);end;end;if msg.changed>0 then call Update_Msg(area,msgs.n);msg.bad=(rc.crossnet>0|rc.dst|rc.encoded~=''|rc.fatt=3|rc.kill~=''|rc.loop|rc.src|rc.twit~='')
if domain.admn.log.all|(domain.admn.log.bad&msg.bad) then call Log_Msg(admn);if domain.admn.delete.good&~msg.bad&rc.fatt~=3 then do;tmp=msg.data.flags 'IMP KILL';MM_EditMsgFlags area nr tmp;end;drop msg. rc.;end;end;end;if domain.admn.export&system.exp then MM_AddToStem 'system.export' 'area';return;Quit:;parse arg return_code,error_msg;error_line=0;rc=0;signal Exit;Read_File: procedure Expose system. txt.;parse arg file,language .;lang.default=system.prg.txtpfx'/'file;lang.lang=system.prg.txtpfx'.'language'/'file;txt.=0;if language~='' then if ~exists(lang.lang) then do;call Log('*** IO-ERROR: Unable to open "'lang.lang'"!!!');call Log(' -> Using default instead.',,4);file=lang.default;end;else file=lang.lang;else file=lang.default;MM_ReadStem file 'txt';if rc>0 then do;call Log('*** IO-ERROR: Unable to open "'file'"!!!');file='';end;return file;Read_Msg: procedure Expose msg. domain. system.;arg area,nr;msg.=0;MM_ReadMsg area nr 'msg.data';call Adjust_Addresses;call Parse_MsgDatas('READMSG')
parse var msg.data.date msg.data.datum ' ' msg.data.time;msg.data.datum=translate(msg.data.datum,'-',' ');msg.data.file='';msg.data.origflags=msg.data.flags;msg.error='';msg.status.0='Nothing to do, msg ok.';if msg.data.text.size=0 then do n=0 to msg.data.text.count-1;msg.data.text.size=msg.data.text.size+length(msg.data.text.n);end;return system.domain;Read_Stats: procedure Expose system.;call Log(' Reading statistics...',,4);parse value statef(system.prg.stats) with . . . . . . . desc;desc=strip(desc);if Check_Hex(desc,system.statcnt) then do;tmp=system.statistics;do while tmp~='';parse var tmp name tmp;if name='' then iterate;parse var desc 1 num 5 desc;system.stat.name=x2d(num);end;end;if system.stat.uday=0 then system.stat.uday=date(i);system.stats=1;return;Remap: procedure Expose domain. msg. remap. system.;parse arg type,address,username,area;if remap.type.count=0 then return 0;old_addr=address;new_addr=address;old_name=username;new_name=username;dom=type'DOMAIN';dmn=msg.data.dom;remapped=0
upper address username;do n=0 to remap.type.count-1 while ~remapped;mode=Remap_GetMode(remap.type.n.addr.old,remap.type.n.addr.new.dmn~='', remap.type.n.name.old,remap.type.n.name.new);select;when mode=0 then iterate;when mode=1 then if Check_Pattern(remap.type.n.name.old,new_name) then new_name=remap.type.n.name.new;when mode=2 then if Check_Pattern(Replace(remap.type.n.addr.old,'#?','*'),new_addr) then do;new_addr=remap.type.n.addr.new.dmn;if pos('*',new_addr)>0 then new_addr=Resolve_Wildcard(old_addr,remap.type.n.addr.old,new_addr);end;when mode=3 then if Check_Pattern(Replace(remap.type.n.addr.old,'#?','*'),new_addr) then do;new_name=remap.type.n.name.new;if pos('*',new_addr)>0 then new_addr=Resolve_Wildcard(old_addr,remap.type.n.addr.old,new_addr);end;when mode=4 then if Check_Pattern(remap.type.n.name.old,old_name) then do;new_addr=remap.type.n.addr.new.dmn;if pos('*',new_addr)>0 then new_addr=Resolve_Wildcard(old_addr,remap.type.n.addr.old,new_addr)
if remap.type.n.name.new~='' then new_name=remap.type.n.name.new;end;when mode=5 then if Check_Pattern(Replace(remap.type.n.addr.old,'#?','*'),old_addr)& Check_Pattern(remap.type.n.name.old,old_name) then do;new_addr=remap.type.n.addr.new.dmn;new_name=remap.type.n.name.new;if pos('*',new_addr)>0 then new_addr=Resolve_Wildcard(old_addr,remap.type.n.addr.old,new_addr);end;otherwise iterate;end;remapped=upper(old_addr)~=upper(new_addr)|upper(old_name)~=upper(new_name);end;if ~remapped then return 0;if type='FROM' then do;file='Src';info='SOURCE';reply=0;stat='SRC';end;else;do;file='Dst';info='DESTINATION';stat='DST';if find(system.addresses,upper(new_addr))>0 then do;call Del_Flag('DEL');call Del_Flag('KILL');end;end;call Count_Stat('RMP'stat);info_old=old_addr;info_new=new_addr;if old_name~=new_name then do;info_old=old_name '%' info_old;info_new=new_name '%' info_new;end;if remap.type.n.flags='' then info_flags='';else;do;info_flags=strip(msg.data.flags);msg.data.flags=remap.type.n.flags;end;adr=type'ADDR'
lang=type'LANG';msg.data.adr=new_addr;msg.data.type=new_name;info=info'-address remapped from' info_old 'to' info_new;call Parse_MsgDatas('REMAP');if remap.n.addinfo=1 then do;call Read_File('Remap_'file,msg.data.lang);do n=0 to txt.count-1;tmp=Replace_Embedded(txt.n);tmp=Replace(tmp,info_new,'%n');tmp=Replace(tmp,info_old,'%o');MM_AddToStem 'msg.data.addtxt' 'tmp';end;msg.changed=2;info=info', info added';end;else;if Get_AddrDomain(old_addr)=Get_AddrDomain(new_addr) then call Set_MsgChanged;else msg.changed=2;if remap.n.reply=1 then do;call Read_File('Remap_Reply',msg.data.fromlang);write.=0;do n=0 to txt.count-1;tmp=Replace_Embedded(txt.n);tmp=Replace(tmp,info_new,'%n');tmp=Replace(tmp,info_old,'%o');call Add_Write(tmp);end;sysop=Get_Sysop(msg.data.from,msg.data.fromaddr);txt=Get_Text(msg.data.fromlang,'SUBJ','REMAP_REPLY');call Write_Msg('write',area,sysop,msg.data.fromaddr,txt,system.tmpfile);info=info', sender notified';end;info=info'.';call Add_Status(info);call Log(' 'info);if info_flags~='' then do
info_flags='Flags changed from "'info_flags'" to "'msg.data.flags'".';call Log(' 'info_flags);call Add_Status(info_flags);end;return 1;Remap_GetMode: procedure Expose system.;parse arg oa,na,on,nn;oa=oa~='';on=on~='';nn=nn~='';if ~oa&na=0&on&nn then return 1;if oa&na=1&~on&~nn then return 2;if oa&na=0&on&nn then return 3;if ~oa&na>0&on then return 4;if oa&na=1&on&nn then return 5;return 0;Replace: procedure;parse arg string,new,old;do while index(string,old)~=0;interpret "parse var string l '"old"' r";string=l||new||r;end;return string;Replace_Embedded: procedure Expose msg. system.;parse arg text;if pos('%',text)=0 then return text;text=replace(text,msg.data.datum,'%cd');text=replace(text,msg.data.time,'%ct');text=replace(text,msg.data.fromaddr,'%fa');text=replace(text,msg.data.from_first,'%ff');text=replace(text,msg.data.from_sur,'%fs');text=replace(text,msg.data.from,'%f');text=replace(text,msg.data.flags,'%F');text=replace(text,system.date,'%id');text=replace(text,system.time,'%it')
text=replace(text,system.nodelists,'%nl');text=replace(text,system.addr,'%sa');text=replace(text,system.sysop_first,'%sf');text=replace(text,system.sysop_sur,'%ss');text=replace(text,system.sysop,'%s');text=replace(text,msg.data.subj,'%S');text=replace(text,msg.data.toaddr,'%ta');text=replace(text,msg.data.to_first,'%tf');text=replace(text,msg.data.to_sur,'%ts');text=replace(text,msg.data.to,'%t');return text;Report_Error:;signal off break_c;signal off break_d;signal off break_e;signal off break_f;signal off halt;signal off ioerr;signal off syntax;call Log(' An internal error happened! Error-analysis started!',,0);call Msg_Head('4E6F74696669636174696F6E2061626F757420616E206572726F72206F66'x system.prg.id);call Add_Write('202A2A2A'x error_msg '2A2A2A'x);call Add_Write();call Add_Write(' 'right(error_line,4,'0')':' strip(translate(sourceline(error_line),' ','9'x)));call Add_Write();call Add_Write();call Add_Write();call Get_SystemInfo();call delete(system.tmpfile);address command
call Add_Write();end;call Add_Write();MM_ReadStem system.prg.cfg 'write.text' 'APPEND';tmp='633A6C697374'x;if exists(tmp) then do;address command tmp '>'system.tmpfile system.prg.cfgpath 'dates';tmp=rc;call Add_Write();MM_ReadStem system.tmpfile 'write' 'APPEND';call delete(system.tmpfile);if tmp~=0 then call Add_Write('RC =' tmp);end;call Add_Write();call Add_Write();call Notify_Author('4572726F722D5265706F7274206F66'x system.prg.name);return;Request_Choice: procedure Expose system.;parse arg text,buttons,ret_vals;title=system.prg.name'-Requester';text=translate(Replace(text,'0A'x,'\n'),'1b'x,'\');if length(text)<40 then text=center(text,40);MM_Requester title 'text' 'buttons';if rc=0 then rc=words(ret_vals);return compress(word(ret_vals,rc),'_');Resolve_Wildcard: procedure;parse arg address,from,to;parse var address a.1 ':' a.2 '/' a.3 '.' a.4 '@' a.5;parse var from f.1 ':' f.2 '/' f.3 '.' f.4 '@' f.5;parse var to t.1 ':' t.2 '/' t.3 '.' t.4 '@' t.5;do n=1 to 5;wposf=pos('*',f.n);wpost=pos('*',t.n);select
when wposf=0&wpost=0 then r.n=t.n;when wposf>0&wpost=0 then r.n=f.n;when wposf>0&wpost>0 then do;dpos=compare(f.n,t.n);if dpos=0 then tmp='';else tmp=substr(t.n,dpos,wpost-dpos);r.n=left(f.n,max(dpos-1,0))||tmp||substr(a.n,wposf);end;otherwise;do;call Log('*** WILDCARD-ERROR: Unable to resolve' f.n '->' t.n '('from '->' to')');call Log(' Remap NOT possible!',3);do m=1 to 5;r.m=a.m;end;leave n;end;end;end;return r.1':'r.2'/'r.3'.'r.4'@'r.5;Route_Multiple_FATT: procedure Expose domain. msg. msgs. rc. system.;parse arg area,admn,first_file additional_files,own;call Log(' Multiple FATT detected, writing additional msgs...');call Read_File('FATT-Multiple',msg.data.tolang);file_bak=msg.data.file;flags_bak=msg.data.flags;msg.data.file=system.tmpfile'2';if domain.admn.delete.own then msg.data.flags=msg.data.flags 'KILL';do n=0 to txt.count-1;txt.n=Replace_Embedded(txt.n);end;MM_AddToStem 'txt' 'system.prg.tearline';MM_WriteStem msg.data.file 'txt';do while additional_files~=''
parse var additional_files filename additional_files;if filename='' then iterate;if ~own then call Log(' -> Generating new msg for "'filename'".');msg.data.subj=filename;call Move_FATT(area,admn,own);if ~own then MM_WriteMsg area 'msg.data';end;call delete(msg.data.file);msg.data.file=file_bak;msg.data.flags=flags_bak;msg.data.subj=first_file;msg.changed=max(msg.changed,1);return;Search_FATT: procedure Expose domain. msg. rc. system.;parse arg area,dmn,name,own;upper dmn;if own&domain.dmn.fatt.ownpath~='' then mailpath=domain.dmn.fatt.ownpath;else;do;tmp=Make_Valid(area);mailpath=system.mtrx.path.tmp;end;check.=0;MM_AddToStem 'check' 'mailpath';MM_AddToStem 'check' 'system.mm.inbound';MM_AddToStem 'check' 'system.mm.baddir';MM_AddToStem 'check' 'system.badpath';name=BaseName(name);if domain.dmn.fatt.adjust&pos(',',name)>0 then parse var name name ',' ext;found=0;do n=0 to check.count-1 while ~found;path=check.n;file=path||name;found=exists(file);if ~domain.dmn.fatt.adjust then iterate
call Command('c:list >'system.tmpfile file',#? lformat "%p%n"');MM_ReadStem system.tmpfile 'list';if list.count>0&exists(list.0) then do;do m=0+(~found) to list.count-1;call Log(' -> Deleting "'list.m'"...',,4);call delete(list.m);end;if found then break;if rename(list.0,file) then call Log(' -> "'list.0'" renamed to "'file'".',,3);else;do;call Log('*** IO-ERROR: Unable to rename "'list.0'" to "'file'"!');file=list.0;name=BaseName(file);end;found=1;end;end;call delete(system.tmpfile);if found then do;if upper(path)~=upper(mailpath) then file=Move_File(file,mailpath||name);parse value statef(file)'FF'x' ?' with . msg.fatt.size . . . . . desc 'FF'x .;desc='FATT: From' msg.data.fromaddr 'to' msg.data.toaddr';' desc;MM_SetFilenote file 'desc';end;else;do;call Log(' -> Unable to locate file "'name'"!!!');file=Replace_Embedded(replace(Get_Text(msg.data.tolang,'SUBJ','NOFATT'),name,'%fatt'));rc.fatt=0;rc.was_fatt=1;call Del_Flag('FATT');end;return file;Send_Receipt: procedure Expose domain. msg. system.
parse arg area,nr;call Log(' SENDING RECEIPT!!!');call Forward_Msg('ReturnReceiptRequest',msg.data.fromlang,area,msg.data.from, msg.data.fromaddr,Get_Text(msg.data.fromlang,'SUBJ','RRR'),,1);call Add_Status('Returned Receipt-Request.');call Count_Stat('RRR');return;Set_MsgChanged: procedure Expose msg. system.;msg.changed=max(msg.changed,1+(system.mm.release<421));return;Set_RC: procedure Expose rc. system.;parse arg type,ret;if rc.type~=''&rc.type~=0 then if datatype(rc.type,'N') then rc.type=max(rc.type,ret);else rc.type=strip(rc.type ret);else rc.type=ret;call Debug('RC',type':' rc.type);return rc.type;Stop_FATT: procedure Expose msg. domain. system. rc.;arg area,nr,dmn;call Log(' FILEATTACH!!! From' msg.data.from 'to' msg.data.to);msg.data.subj=BaseName(strip(msg.data.subj));fatt.file=Search_FATT(area,dmn,msg.data.subj,0);if rc.fatt=0 then return;notify=domain.dmn.fatt.notify;found=0;rc.fatt=0;rc.was_fatt=1;call Del_Flag('FATT');select;when domain.dmn.fatt.hold then do;notify_txt='put on hold'
msg.data.subj=msg.data.subj',' msg.fatt.size 'bytes';parse var msg.data.toaddr zone ':' net '/' node '.' point '@' .;flow=system.mm.outbound||zone'.'net'.'node'.'point'.HLO';open=1;if ~open(out,flow,a) then if ~open(out,flow,w) then if ~open(out,flow'_TMP',a) then if ~open(out,flow'_TMP',w) then do;call Log('*** IO-ERROR: Unable to create flow-file' flow'!!!');open=0;notify=0;end;if open then do;call writeln(out,'^'fatt.file);call close(out);call Log(' -> File' fatt.file 'was put on hold for' msg.data.toaddr'.');end;end;when domain.dmn.fatt.bad then do;notify_txt='moved to the #BADDIR';fatt.file=Move_File(fatt.file,system.mm.baddir||BaseName(fatt.file));end;otherwise;do;notify_txt='deleted';if delete(fatt.file) then call Log(' -> File' fatt.file 'was deleted.');else call Log('*** IO-ERROR: Unable to delete "'fatt.file'"!');end;end;if notify then do;tmp=word('Killed Hold',domain.dmn.fatt.hold+1);call Insert_Text('FATT-'tmp'_ToDst',msg.data.tolang);call Read_File('FATT-'tmp'_ToSrc',msg.data.fromlang)
write.=0;do n=0 to txt.count-1;call Add_Write(Replace_Embedded(txt.n));end;sysop=Get_Sysop(msg.data.from,msg.data.fromaddr);txt=Get_Text(msg.data.fromlang,'SUBJ','FATT_TOSRC');call Write_Msg('write',area,sysop,msg.data.fromaddr,txt,system.tmpfile);info='File was' notify_txt', source & destination were notified.';end;else info='';call Add_Status('FILEATTACH stopped!!!' info);call Count_Stat('FATT');return;Stop_Loop: procedure Expose domain. msg. system.;parse arg area,nr,src;call Log(' NETMAIL-LOOP!!!');tmp=msg.data.foot.count-1;dstaddr=Get_Addr_From_Via(msg.data.foot.tmp);if dstaddr='???' then dstaddr=msg.data.toaddr;dstname=Get_Name(dstaddr);dstlang=Get_Language(dstaddr);if dstaddr~=msg.data.toaddr&dstname~=msg.data.to then do;if ~msg.system then do;flg='CRASH';txt=flg'ED';end;else;do;flg='';txt='SENT';end;call Forward_Msg('Loop_ToDst',msg.data.tolang,area,msg.data.to,msg.data.toaddr, Get_Text(msg.data.tolang,'SUBJ','LOOP_TODST'),flg,0);msg.data.text.0='';msg.data.text.1='[...]';msg.data.text.2=''
call Move_Msg(area,nr,system.badarea,'Unknown sender');call Add_Status('Unknown SOURCE-address detected:' msg.data.fromaddr', msg forwarded.');call Count_Stat('UNKNSRC');return;Update_Msg: procedure Expose msg. system.;parse arg area,nr;if msg.changed=2 then do;call Adjust_Kludges();call Add_Kludge(0,'ORIGDATE:' msg.data.date);msg.data.file=system.tmpfile;msg.data.flags=msg.data.flags 'IMP';call Write_Msg_File('msg.data',system.tmpfile,0,1);end;MM_EditMsg area nr 'msg.data';if msg.changed=2 then call delete(system.tmpfile);return;Usage:;say;say 'Usage: [RX] MM_StarTrack[.rexx] [CPLCFG]';say;call Quit(0,'Usage requested');Wait_AreasWindow: procedure Expose system.;MM_AreasWin;if rc=0 then return;bell='07'x;cr='0D'x;call Request_Choice('\c\n\1'system.prg.id'\0 is waiting.\n\nPlease go back to the Areas-Window' 'as soon as possible!\n','* _WAIT ','_');tmp='Waiting for Areas-Window...';call writech(STDOUT,bell||tmp||cr);call Log(tmp,,4);rc=1;do while rc~=0;MM_AreasWin;call writech(STDOUT,bell);call Delay(250);end
return;Write_Msg: procedure Expose domain. msg. system. write.;starmsg.=0;parse arg stem,area,starmsg.data.to,starmsg.data.toaddr,starmsg.data.subj,starmsg.data.file,starmsg.data.flags;MM_GetAreaInfo area 'ainfo';is_matrix=ainfo.type='MAIL';if is_matrix then do;tmp=Check_Addr(starmsg.data.toaddr,'ADJUST');MM_GetNearestAddr tmp 'tmp_addr';if rc~=0 then tmp_addr=system.addresses.0;tmp=Get_AddrDomain(tmp_addr);starmsg.data.fromaddr=domain.tmp.replyaddr;if starmsg.data.fromaddr=0 then starmsg.data.fromaddr=tmp_addr;end;else;do;starmsg.data.tear=system.prg.fid;starmsg.data.origin=translate(system.prg.cr,'[]','()');end;starmsg.data.from=system.prg.fid;if domain.tmp.delete.own=1 then if find(starmsg.data.flags,'KILL')=0 then starmsg.data.flags=starmsg.data.flags 'KILL';call Add_Kludge(1,'ROBOTMAIL');call Write_Msg_File(stem,starmsg.data.file,is_matrix,is_matrix);MM_WriteMsg area 'starmsg.data';if rc>0 then call Log('*** MM-ERROR: Unable to write a new msg in' area'!!!');call delete(starmsg.data.file)
drop starmsg. write.;return;Write_Msg_File: procedure Expose msg. system. write.;parse arg stem,file,tear,via;if tear then MM_AddToStem stem'.text' 'system.prg.tearline';if via then call Add_Via(stem'.foot');MM_WriteStem file stem'.head';ret=rc;MM_WriteStem file stem'.addtxt' 'APPEND';ret=ret+abs(rc);MM_WriteStem file stem'.text' 'APPEND';ret=ret+abs(rc);MM_WriteStem file stem'.foot' 'APPEND';ret=ret+abs(rc);if ret>0 then call Log('*** IO-ERROR: Troubles while writing file "'file'"!!!');return;Write_Stats: procedure Expose domain. system.;call Check_Processed;call Log(' Writing statistics...',,4);line=' 'copies('-',30);statistic.=0;tmp='Netmail-Statistics of' system.prg.id':';total.err=system.stat.crossnet+system.stat.empty+system.stat.encoded+system.stat.exclude +system.stat.kill+system.stat.loop+system.stat.twit+system.stat.unkndst +system.stat.unknsrc;total.ok=system.stat.ntd+system.stat.rmpsrc+system.stat.rmpdst+system.stat.rrr;call Add_Stat();call Add_Stat();call Add_Stat(' 'tmp)
call Add_Stat('Mails without errors',total.ok);call Add_Stat();call Add_Stat();call Add_Stat(' 'copies('=',30));call Add_Stat('Total mails processed',system.stat.processed);call Add_Stat('Total kbytes routed',system.stat.size);call Add_Stat();call Add_Stat('Times program used',system.stat.ucnt);call Add_Stat();call Add_Stat();tmp=system.statistics;desc='';do while tmp~='';parse var tmp name tmp;if name='' then iterate;desc=desc||d2h(system.stat.name);end;desc=desc d2x(hash(desc));MM_WriteStem system.prg.stats 'statistic';call delay(25);MM_SetFileNote system.prg.stats 'desc';return;Add_AllowEncoded: procedure Expose cpl. domain. system.;arg dmn,mode,var,patterns;do while patterns~='';parse var patterns ptrn patterns;if strip(ptrn)='' then iterate;call Add_Cfg_Stem(var'.encoded.'mode,Replace(ptrn,'#?','*'));end;domain.dmn.fkt.allowenc=1;return;Add_Cfg: procedure Expose cpl. domain. remap. system.;parse arg var,val,add,force;upper var;if force~=1&val=0 then return;if datatype(val,'N')&add='' then q=''
else q="'";line=var'='q||translate(compress(val,'000A0D'x),'FEFF'x,'2227'x)||q||add;MM_AddToStem 'cpl' 'line';interpret line;return;Add_Cfg_Stem: procedure Expose cpl. domain. remap. system.;parse arg stem,value;upper stem;MM_AddToStem stem 'value';if find(cpl.stems,stem)=0 then cpl.stems=cpl.stems stem;return;Add_Full_Pattern: procedure Expose cfg. cpl. n system.;parse arg type,args;call Parse_Cfg_Args(upper(args),'FROM_PATTERN/A,FROMADDR_PATTERN/A,TO_PATTERN/A,TOADDR_PATTERN/A,SUBJ_PATTERN/A','#'type,l);args='';uargs='';found=find('EXCLUDE KILL TWIT',type)>0;key_l=n+1;do n=n+1 to cfg.count-1;call Parse_Cfg_Line(n);if key='' then iterate;if key='ARGUMENTS' then if type='EXCLUDE' then call Quit(15,'You must not use "Arguments" for #EXCLUDE at line' l'!!!');else found=1;else;do;n=n-1;args='';uargs='';end;leave;end;if ~found then call Quit(15,'You have to set "Arguments" for #'type 'at line' key_l'!!!');tmp='system.ptrn.'type'.';call Add_Cfg_Stem(tmp'from',Replace(cfg.prm.from_pattern,'#?','*'))
call Add_Cfg_Stem(tmp'fromaddr',Replace(cfg.prm.fromaddr_pattern,'#?','*'));call Add_Cfg_Stem(tmp'to',Replace(cfg.prm.to_pattern,'#?','*'));call Add_Cfg_Stem(tmp'toaddr',Replace(cfg.prm.toaddr_pattern,'#?','*'));call Add_Cfg_Stem(tmp'subj',Replace(cfg.prm.subj_pattern,'#?','*'));select;when type='EXCLUDE' then call Add_Cfg_Stem(tmp'mode','*');when type='EXECUTE' then call Add_Cfg_Stem(tmp'mode',args);when type='FORWARD' then call Get_ForwardDatas(tmp,args,'#FORWARD-"Arguments"',l);otherwise;do;if args~='' then call Parse_Cfg_Args(args,'BOUNCE/S,MOVE/S','#'type'-"Arguments"',l);call Add_Cfg_Stem(tmp'mode','*' uargs);end;end;system.fkt.fp.type=1;return;Add_Matrix: procedure Expose cpl. system.;parse arg areaname,addr,pth;tmp='system.mtrx.';call Add_Cfg_Stem(tmp'area',areaname);call Add_Cfg_Stem(tmp'addr',addr);call Add_Cfg(tmp'path.'Make_Valid(areaname),pth);system.mtrx.count=system.mtrx.area.count;return;Add_Pattern: procedure Expose cpl. system.;parse arg type,stem,pt md,l;upper type stem pt;pt=strip(pt)
md=strip(md);if find('EXECUTE FORWARD',type)=0 then md=upper(md);if type='EXCLUDE'|md='' then md='*';tmp='system.'type'.'stem'.';call Add_Cfg_Stem(tmp'ptrn',Replace(pt,'#?','*'));select;when type='EXCLUDE' then call Add_Cfg_Stem(tmp'mode',md);when type='EXECUTE' then call Add_Cfg_Stem(tmp'mode',md);when type='FORWARD' then call Get_ForwardDatas(tmp,md,'#FORWARD',l);when type='ROBOT' then nop;otherwise;do;if md~='*' then call Parse_Cfg_Args(md,'BOUNCE/S,MOVE/S','#'type,l);call Add_Cfg_Stem(tmp'mode',md);end;end;system.fkt.np.type=1;return;Add_Script: procedure Expose script.;parse arg line;MM_AddToStem 'script' 'line';return;Analyse_Remap: procedure Expose cfg. cpl. remap. system.;parse arg . '#REMAP' type .,n,l,args;if args~='' then call Quit(15,'Too many arguments "'args'" for "#REMAP" at line' l'!');key='';tmp.='';key.=0;line=l;rarg='Requiered arguments missing for';tmp.addr.new.a.count=0;tmp.addinfo=0;tmp.addr.new.d.count=0;tmp.reply=0;do n=n+1 to cfg.count-1;call Parse_Cfg_Line(n);select
when key='' then iterate;when left(key,1)='#' then leave;when find('NAME ADDRESS',key)>0 then do;call Parse_Cfg_Args(Replace(args,'*','#?'),'OLD/K,NEW/K',key,l);if cfg.prm.old=''&cfg.prm.new='' then call Quit(15,rarg '"#REMAP' key'" at line' l'!');if key.key then call Quit(15,'Multiple "'key'"-lines for #REMAP'type 'at line' l 'are not allowed!');key.key=1;if key='ADDRESS' then do;key='ADDR';if cfg.prm.old~=''&pos('*',cfg.prm.old)=0&pos('?',cfg.prm.old)=0& Check_Addr(cfg.prm.old,'NOADJ')='' then call Quit(15,'Invalid address "'cfg.prm.old'" for "#REMAP' key'" at line' l'!');do while cfg.prm.new~='';parse var cfg.prm.new address cfg.prm.new;if pos('*',address)=0&pos('?',address)=0&Check_Addr(address,'NOADJ')='' then call Quit(15,'Invalid address "'address'" for "#REMAP' key'" at line' l'!');dmn=Get_AddrDomain(address);stem='tmp.addr.new.';MM_AddToStem stem'a' 'address';MM_AddToStem stem'd' 'dmn';end;end;tmp.key.old=cfg.prm.old;tmp.key.new=cfg.prm.new;end;when key='FLAGS' then do
call Parse_Cfg_Args(args,'FLAGS/A',key,l);tmp.key=cfg.prm.flags;end;when find('ADDINFO REPLY',key)>0 then if args='' then if type='FROM'&key='REPLY' then call Quit(15,'Invalid option "'Reply'" for #REMAPFROM at line' l'!');else tmp.key=1;else call Quit(15,'Too many arguments "'args'" for "#REMAP' key'" at line' l'!');otherwise call Quit(11,cfg.err l': Unknown keyword' key);end;end;if Remap_GetMode(tmp.addr.old,tmp.addr.new.a.count,tmp.name.old,tmp.name.new)=0 then call Quit(15,'Wrong number of arguments for "#REMAP" begining at line' line'!');stem='remap.'type'.'remap.type.count'.';if tmp.addr.old~='' then call Add_Cfg(stem'addr.old',tmp.addr.old);do m=0 to tmp.addr.new.a.count-1;call Add_Cfg(stem'addr.new.'tmp.addr.new.d.m,tmp.addr.new.a.m);end;if tmp.name.old~='' then call Add_Cfg(stem'name.old',Replace(tmp.name.old,'#?','*'));if tmp.name.new~='' then call Add_Cfg(stem'name.new',tmp.name.new);if tmp.flags~='' then call Add_Cfg(stem'flags',tmp.flags);call Add_Cfg(stem'addinfo',tmp.addinfo)
call Add_Cfg(stem'reply',tmp.reply);remap.type.count=remap.type.count+1;return n-1;Check_MM_Cfg:;MM_SearchInStem 'cfg' 'domain' '?#DOMAIN#?' 'NUM';MM_GetAreas 'matrix' 'MAIL';system.singlemail=matrix.count=2&words(system.alldomains)>=2;if ~system.singlemail&matrix.count<domain.count+1 then call Quit(23,'Incorrect number of #MAILAREAS!!! Please read the docs!');if system.singlemail then call Add_Cfg('system.singlemail',1);call Add_Cfg('system.mailareas',matrix.count);system.bad_point='9999:9999/9999.9999@BadNet';if find(system.addresses,upper(system.bad_point))=0 then call Quit(24,'"#ADDRESS' system.bad_point'" not defined! => See docs 3.5!');system.bad_node='9999:9999/9999.0@BadNet';MM_GetNodeInfo system.bad_node 'tmp';if RC~=0 then call Quit(25,'"#NODE' system.bad_node'" not defined! => See docs 3.6!');return;Compile_Cfg: procedure Expose domain. remap. system.;call Log(' Reading & compiling config...');MM_ReadStem system.prg.cfg 'cfg';if rc>0 then call Quit(21,system.prg.cfg);cpl.=0;cpl.stems=''
call Add_Cfg(' DOMAIN.',0,,1);call Add_Cfg(' REMAP.','',,1);call Add_Cfg(' LOG','LOG');call Add_Cfg(' SIZE','SIZE');call Check_MM_Cfg;cfg.err='Line';cfg.texts='#SUBJ_BOUNCE_CROSSNET #SUBJ_BOUNCE_ENCODED #SUBJ_BOUNCE_KILL' '#SUBJ_BOUNCE_TWIT #SUBJ_BOUNCE_UNKNDST #SUBJ_CROSSNET_TODST' '#SUBJ_CROSSNET_TOSRC #SUBJ_FATT_TOSRC #SUBJ_LOOP_TODST' '#SUBJ_LOOP_TOLINK #SUBJ_LOOP_TOSRC #SUBJ_REMAP_REPLY #SUBJ_RRR' '#SUBJ_UNKNSRC #SUBJ_NOFATT #SUBJ_BOUNCE_SPLITENCODED' '#SUBJ_FATT_NOTFOUND';rep_addr=0;remap.from.count=0;remap.to.count=0;system.domains='';system.vdomains='';system.languages='';do n=0 to cfg.count-1;call Parse_Cfg_Line(n);select;when key='' then iterate;when key='#DEBUG' then call Add_Cfg('system.debug',1);when key='#DOMAIN' then do;call Parse_Cfg_Args(args,'DOMAIN/A,ZONES,ADJUST/S',key,l);dmn=Make_Valid(cfg.prm.domain);udmn=upper(cfg.prm.domain);zns=strip(translate(cfg.prm.zones,' ',','));var_dmn='domain.'dmn;if index(system.addresses,'@'udmn)=0 then
call Quit(11,cfg.err l': Unknown domain "'cfg.prm.domain'"!');if find(system.vdomains,dmn)>0 then call Quit(11,cfg.err l': Domain "'cfg.prm.domain'" was already used in another #DOMAIN-statement!');system.domains=system.domains cfg.prm.domain;system.vdomains=system.vdomains dmn;call Add_Cfg(' 'dmn,dmn);call Add_Cfg(var_dmn'.zones',zns);if zns~=''&cfg.prm.adjust then call Add_Cfg(var_dmn'.adjust',1);end;when key='ALLOWENCODEDFROM' then call Add_AllowEncoded(dmn,'From',var_dmn,uargs);when key='ALLOWENCODEDTO' then call Add_AllowEncoded(dmn,'To',var_dmn,uargs);when key='BOUNCE' then do;call Parse_Cfg_Args(args,'CROSSNET/S,UNKNDST/S,WRONGADDR/S',key,l);call Add_Cfg(var_dmn'.bounce.crossnet',cfg.prm.crossnet);call Add_Cfg(var_dmn'.bounce.unkndst',cfg.prm.unkndst);call Add_Cfg(var_dmn'.bounce.wrongaddr',cfg.prm.wrongaddr);end;when key='CHECKENCODED' then do;call Parse_Cfg_Args(args,'SIZE/A/N,BOUNCE/S,MOVE/S,SPLIT/S',key,l);tmp='';if cfg.prm.bounce then tmp=tmp 'BOUNCE';if cfg.prm.move then tmp=tmp 'MOVE'
if cfg.prm.split then tmp=tmp 'SPLIT';if cfg.prm.size<1024 then call Quit(13,cfg.err l':' key '- Value too low ('size')');call Add_Cfg(var_dmn'.encoded.size',cfg.prm.size);call Add_Cfg(var_dmn'.encoded.mode',strip(tmp));end;when key='CHECKFATT' then do;call Parse_Cfg_Args(args,'ADJUST/S,MOVEBAD/S,NOTIFY/S,PUTONHOLD/S,MOVEOWN/K',key,l);tmp=cfg.err l': "CheckFATT" - too many parameters';select;when cfg.prm.putonhold&cfg.prm.movebad then call Quit(11,tmp '(Only "PutOnHold" or "MoveBad")!');when cfg.prm.notify&cfg.prm.putonhold then call Quit(11,tmp '("PutOnHold" includes "Notify")!');when cfg.prm.movebad then call Add_Cfg(var_dmn'.fatt.bad',1);when cfg.prm.putonhold then call Add_Cfg(var_dmn'.fatt.hold',1);otherwise call Add_Cfg(var_dmn'.fatt.delete',1);end;call Add_Cfg(var_dmn'.fatt.notify',cfg.prm.putonhold|cfg.prm.notify);call Add_Cfg(var_dmn'.fatt.adjust',cfg.prm.adjust);call Add_Cfg(var_dmn'.fatt.ownpath',path(cfg.prm.moveown));if cfg.prm.moveown~='' then
if ~exists(cfg.prm.moveown) then call Quit(11,cfg.err l': "'cfg.prm.moveown'" does not exist!');call Add_Cfg(var_dmn'.fatt',1);end;when key='CHECKLOOP' then call Add_Cfg(var_dmn'.loop',1);when key='DELETE' then do;call Parse_Cfg_Args(args,'EMPTY/S,GOOD/S,OWN/S',key,l);call Add_Cfg(var_dmn'.delete.empty',cfg.prm.empty);call Add_Cfg(var_dmn'.delete.good',cfg.prm.good);call Add_Cfg(var_dmn'.delete.own',cfg.prm.own);end;when key='EXPORT' then call Add_Cfg(var_dmn'.export',1);when key='FROMADDR' then do;tmp=Check_Addr(args,'NOADJ');if tmp~=args|find(system.addresses,upper(tmp))=0|Get_AddrDomain(tmp)~=dmn then call Quit(11,cfg.err l': Invalid address "'args'"!');call Add_Cfg(var_dmn'.replyaddr',tmp);rep_addr=rep_addr+1;end;when key='LOGFILE' then call Add_Cfg(var_dmn'.log.file',args);when key='LOGMODES' then do;call Parse_Cfg_Args(args,'ALL/S,BAD/S,FLAGS/S,SUBJECT/S,SIZE/S,ROUTING/S,VIAALL/S,VIAADDR/S',key,l);if cfg.prm.all&cfg.prm.bad then
call Quit(11,cfg.err l': "LogModes" - too many parameters (only ALL or BAD)');if cfg.prm.viaall&cfg.prm.viaaddr then call Quit(11,cfg.err l': "LogModes" - too many parameters (only "ViaAddr" or "ViaAll")');call Add_Cfg(var_dmn'.log.all',cfg.prm.all);call Add_Cfg(var_dmn'.log.bad',cfg.prm.bad);call Add_Cfg(var_dmn'.log.flags',cfg.prm.flags);call Add_Cfg(var_dmn'.log.subj',cfg.prm.subject);call Add_Cfg(var_dmn'.log.size',cfg.prm.size);call Add_Cfg(var_dmn'.log.routing',cfg.prm.routing);call Add_Cfg(var_dmn'.log.via.all',cfg.prm.viaall);call Add_Cfg(var_dmn'.log.via.addr',cfg.prm.viaaddr);end;when key='RETURNRECEIPT' then do;call Parse_Cfg_Args(args,'POINTS/S,SYSTEM/S',key,l);call Add_Cfg(var_dmn'.rrr.points',cfg.prm.points);call Add_Cfg(var_dmn'.rrr.system',cfg.prm.system);end;when key='#BADAREA' then do;MM_GetAreaInfo uargs 'bad';if RC=0 then call Add_Cfg('system.badarea',uargs);if bad.type~='MAIL' then call Quit(11,args 'is not a #MAILAREA!!!');if upper(bad.addr)~=upper(system.bad_point) then
call Quit(26,'#BADAREA not correct defined! "'bad.addr'" used instead of "'system.bad_point'"! => See docs 3.8!');call Add_Cfg('system.badaddr',bad.addr);call Add_Cfg('system.baddomain',Get_AddrDomain(bad.addr));call Add_Cfg('system.badpath',path(bad.path));end;when key='#COMPILENL' then if args~='' then call Add_Cfg('system.cplnl',args);else call Quit(13,'No command set for #COMPILENL at line' l'!!!');when key='#EXCLUDEADDR' then call Add_Pattern('EXCLUDE','ADDR',uargs,l);when key='#EXCLUDENAME' then call Add_Pattern('EXCLUDE','NAME',uargs,l);when key='#EXCLUDESUBJ' then call Add_Pattern('EXCLUDE','SUBJ',uargs,l);when key='#EXCLUDE' then call Add_Full_Pattern('EXCLUDE',uargs,l);when key='#EXECUTEADDR' then call Add_Pattern('EXECUTE','ADDR',args,l);when key='#EXECUTENAME' then call Add_Pattern('EXECUTE','NAME',args,l);when key='#EXECUTESUBJ' then call Add_Pattern('EXECUTE','SUBJ',args,l);when key='#EXECUTE' then call Add_Full_Pattern('EXECUTE',args,l)
when key='#FORWARDADDR' then call Add_Pattern('FORWARD','ADDR',args,l);when key='#FORWARDNAME' then call Add_Pattern('FORWARD','NAME',args,l);when key='#FORWARDSUBJ' then call Add_Pattern('FORWARD','SUBJ',args,l);when key='#FORWARD' then call Add_Full_Pattern('FORWARD',args,l);when key='#KILLADDR' then call Add_Pattern('KILL','ADDR',uargs,l);when key='#KILLNAME' then call Add_Pattern('KILL','NAME',uargs,l);when key='#KILLSUBJ' then call Add_Pattern('KILL','SUBJ',uargs,l);when key='#KILL' then call Add_Full_Pattern('KILL',uargs,l);when key='#LANGUAGE' then do;call Parse_Cfg_Args(uargs,'LANG_EXT/A,PATTERN/A',key,l);if cfg.prm.lang_ext='DEFAULT' then call Quit(12,'Invalid #LANGUAGE DEFAULT at line' l);if cfg.prm.lang_ext~=Make_Valid(cfg.prm.lang_ext) then call Quit(12,errortext(35) 'in language' lang_ext 'at line' l);call Add_Cfg_Stem('system.lang.ptrn.'cfg.prm.lang_ext,Replace(cfg.prm.pattern,'#?','*'));if find(system.languages,cfg.prm.lang_ext)>0 then break;system.languages=system.languages cfg.prm.lang_ext
call Add_Cfg_Stem('system.lang.known',cfg.prm.lang_ext);end;when key='#MAILROBOT' then call Add_Pattern('ROBOT','NAME',uargs,l);when key='#NOSTATISTICS' then call Add_Cfg('system.nostats',1);when key='#TWITADDR' then call Add_Pattern('TWIT','ADDR',uargs);when key='#TWITNAME' then call Add_Pattern('TWIT','NAME',uargs);when key='#TWITSUBJ' then call Add_Pattern('TWIT','SUBJ',uargs);when key='#TWIT' then call Add_Full_Pattern('TWIT',uargs);when find('#REMAPFROM #REMAPTO',key)>0 then n=Analyse_Remap(key,n,l,args);when key='#TASKPRI' then do;if ~datatype(args,'N')|args<-5|args>5 then call Quit(12,'Invalid #TASKPRI at line' l);call pragma('p',args);call Add_Cfg('system.taskpri',args);end;when key='#SHOWNL' then call Add_Cfg('system.shownl',args);when key='#STATISTICS' then nop;otherwise call Quit(11,cfg.err l': Unknown keyword' key);end;end;if system.badarea=0|find(system.vdomains,Get_AddrDomain(bad.addr))>0 then call Quit(15,'#BADAREA not correctly configured!')
call Add_Cfg('remap.from.count',remap.from.count,,1);call Add_Cfg('remap.to.count',remap.to.count,,1);call Add_Cfg('system.domains',strip(system.domains));call Add_Cfg('system.vdomains',strip(system.vdomains));call Add_Cfg('system.languages',strip(system.languages));tmp=system.vdomains;do while tmp~='';parse var tmp dmn tmp;if strip(dmn)='' then iterate;if strip(domain.dmn.encoded.form,'b','0 ')~='' then call Add_Cfg('domain.'dmn'.encoded.from',strip(domain.dmn.encoded.from));if strip(domain.dmn.encoded.to,'b','0 ')~='' then call Add_Cfg('domain.'dmn'.encoded.to',strip(domain.dmn.encoded.to));call Add_Cfg('domain.'dmn'.fkt.allowenc',domain.dmn.fkt.allowenc);call Add_Cfg('domain.'dmn'.fkt.rf',domain.dmn.fkt.rf);call Add_Cfg('domain.'dmn'.fkt.rt',domain.dmn.fkt.rt);end;fkt.0='EXCLUDE';fkt.1='EXECUTE';fkt.2='FORWARD';fkt.3='KILL';fkt.4='TWIT';fkt.count=5;do n=0 to fkt.count-1;tst=fkt.n;call Add_Cfg('system.fkt.fp.'tst,system.fkt.fp.tst);call Add_Cfg('system.fkt.np.'tst,system.fkt.np.tst)
call Add_Cfg('system.fkt.'tst,system.fkt.fp.tst|system.fkt.np.tst);end;if ~system.singlemail then do n=0 to matrix.count-1;if upper(matrix.n)=system.badarea then iterate;MM_GetAreaInfo matrix.n 'tmp';dmn=Get_AddrDomain(tmp.addr);if domain.dmn.replyaddr=0 then call Add_Cfg('domain.'dmn'.replyaddr',tmp.addr);end;else;if rep_addr~=domain.count then call Quit(11,'You have to set one FromAddr per #DOMAIN!!!');call Get_MailAreas(system.vdomains);tmp=system.languages;if Read_Texts() then call Quit(12,'No default Misc-texts!!!');do while tmp~='';parse var tmp lang tmp;call Read_Texts(lang);end
'656E643B70617273652076616C75652078326328746D702920776974682070676D206E7220757365723B757365723D73747269702875736572293B69662073797374656D2E7072672E6E616D653D70676D20262073797374656D2E7379736F703D7573'x||'6572207468656E20646F3B6E723D6E722B303B6B6E6F3D2723276E723B7265673D275265676973746572656420746F3A272075736572202728276B6E6F2729273B656E643B656E643B63616C6C204164645F436667282773797374656D2E7072672E73'x||'74617465272C633278286B6E6F292C277827293B63616C6C204164645F436667282773797374656D2E7072672E696E666F272C63327828726567292C277827293B63616C6C204164645F436667282773797374656D2E7072672E666964272C63327828'x||'73797374656D2E7072672E696427202773797374656D2E7072672E7374617465292C277827293B63616C6C204164645F436667282773797374656D2E7072672E746561726C696E65272C63327828272D2D2D272073797374656D2E7072672E66696427'x||'202773797374656D2E7072672E6372292C27782729'x;drop dmn lang mode ptrn size tmp;do until cpl.stems='';parse var cpl.stems stem cpl.stems;stem=strip(stem);if stem='' then iterate
code="do n=0 to" stem".count-1; call Add_Cfg('"stem".'n," stem".n); end;" "call Add_Cfg('"stem".count'," stem".count)";interpret code;end;MM_SortStem 'cpl';MM_ReadStem system.prg.script 'script';MM_SearchInStem 'script' 'tmp' 'Cfg:' 'NUM';if tmp.count=0 then call Quit(22,system.prg.script 'was modified or not found! Please read the docs!');script.count=tmp.0+1;call Add_Script();line='9'x;do n=0 to cpl.count-1;tmp=strip(cpl.n);if length(line tmp)>=1024 then do;call Add_Script(strip(line,'t','; '));line='9'x;end;line=line||tmp';';end;if length(line)>2 then call Add_Script(strip(line,'t','; '));call Add_Script();call Add_Script('return');call Add_Script();MM_WriteStem system.prg.script 'script';MM_CRCFile system.prg.cfg 'cfg_crc';MM_CRCFile system.prg.script 'scr_crc';tmp=c2x(system.prg.ver) cfg_crc scr_crc;MM_SetFileNote system.prg.script 'tmp';return;Get_Cfg_Arg: procedure Expose args cfg. system.;arg keyword,mode,old;uargs=upper(args);p=find(uargs,keyword);if p=0 then do;p=pos(' 'keyword'=',' 'uargs)
if p>0 then args=overlay(' ',args,p+length(keyword));p=find(upper(args),keyword);end;system.cmdopt.keyword=p>0;select;when mode=0 then if p>0 then do;ret=1;args=delword(args,p,1);end;else ret=old;when mode=1 then if p>0 then do;left=subword(args,1,p-1);rest=subword(args,p+1);if left(rest,1)='"' then parse var rest . '"' ret '"' rest;else parse var rest ret rest;args=strip(left strip(rest));end;else ret=old;when mode=2 then do;if left(args,1)='"' then parse var args . '"' ret '"' args;else parse var args ret args;if strip(ret)='' then ret=old;end;otherwise exit 99;end;args=strip(args);ret=strip(ret,'b','" ');return ret;Get_ForwardDatas: procedure Expose cfg. cpl. system.;parse arg stem,args,key,l;call Parse_Cfg_Args(args,'AREA/K/A,TO/A/K,TOADDR/K,SUBJ/K/A,FLAGS/K/M,DELORIGMSG/S',key,l);err='in #FORWARD at line' l'!!!';if cfg.prm.area~='%ma' then do;MM_GetAreaInfo cfg.prm.area 'data';if RC~=0 then call Quit(15,'Unknown area "'cfg.prm.area'"' err);end;else data.type='MAIL';if data.type='MAIL' then do
tmp=Check_Addr(cfg.prm.toaddr,'NOADJ');if tmp='' then call Quit(15,'Invalid address "'cfg.prm.toaddr'"' err);end;call Add_Cfg_Stem(stem'mode',cfg.prm.area'¡'cfg.prm.to'¡'cfg.prm.toaddr'¡'cfg.prm.subj'¡'|| cfg.prm.flags'¡'cfg.prm.delorigmsg);return;Get_MailAreas: procedure Expose cpl. system.;arg domains;MM_GetAreas 'tmp' 'MAIL';if tmp.count~=system.mailareas then call Quit(11,'Incorrect number of #MAILAREAS!!!');do n=0 to tmp.count-1;MM_GetAreaInfo tmp.n 'info';if find(domains,Get_AddrDomain(info.addr))=0 then iterate;if pos(':',info.altpath)=0 then info.altpath=info.path;call Add_Matrix(tmp.n,info.addr,path(info.altpath));end;call Add_Cfg('system.mtrx.count',system.mtrx.count);call Add_Cfg('system.mailareas.all',tmp.count);if index('54494C4F2057494E4B4C45523B'x,upper(system.sysop))>0 then system.mtrx.count=0;return;Parse_Cfg_Args: procedure Expose cfg. system.;parse arg args,tpl,cfgkey,l;args=strip(translate(args,' ','9'x'='));if args='' then call Quit(15,'No arguments given for' cfgkey 'at line' l'!!!')
pk=pos('/K',tpl);ps=pos('/S',tpl);select;when pk=0&ps=0 then p=0;when pk=0&ps>0 then p=ps;when ps=0&pk>0 then p=pk;otherwise p=min(pk,ps);end;p=lastpos(',',left(tpl,p));tpl=substr(tpl',',p+1)||left(tpl,max(p-1,0));do while tpl~='';parse var tpl template ',' tpl;parse var template keyword '/' .;bool=pos('/S',template)>0;key=pos('/K',template)>0;must=pos('/A',template)>0;num=pos('/N',template)>0;select;when must then cfg.prm.keyword='0'x;when bool then cfg.prm.keyword=0;when num then cfg.prm.keyword=0;otherwise cfg.prm.keyword='';end;if bool|key then mode=~bool;else mode=2;cfg.prm.keyword=Get_Cfg_Arg(keyword,mode,cfg.prm.keyword);if must&cfg.prm.keyword='0'x then call Quit(15,template 'for' cfgkey 'missing at line' l);if num&~datatype(cfg.prm.keyword,'N') then if ~must&cfg.prm.keyword='' then cfg.prm.keyword=0;else call Quit(15,'Numeric value expected for'cfgkey template' at line' l', but is "'cfg.prm.keyword'"!!!');end;if args~='' then call Quit(10,'Unknown option(s) "'args'" for' cfgkey 'at line' l'!!!')
return;Parse_Cfg_Line:;parse arg l;parse value strip(translate(cfg.l,' ','9'x)) with key args ';' .;key=upper(strip(key));args=strip(args);uargs=upper(args);l=l+1;return;Read_Cfg: procedure Expose domain. remap. system.;parse arg system.nocpl;parse value statef(system.prg.script) with . size . . . . . version cfg_crc scr_crc;if ~datatype(version,'X') then version='';MM_CRCFile system.prg.cfg 'crc';if(x2c(version)=system.prg.ver&crc=cfg_crc&~system.forcecpl)|system.nocpl then do;MM_CRCFile system.prg.script 'crc';if crc=scr_crc|system.nocpl then do;call Log(' Reading config...',,3);call Cfg;call Log(' 'system.prg.info,,3);return;end;end;call Compile_Cfg;call Log(' 'system.prg.info,,3);return;Read_Texts: procedure Expose cfg. cpl. system.;arg lang .;file=Read_File('Misc',lang);if lang='' then lang='DEFAULT';else;if pos('.'lang,upper(file))=0 then return 0;l=0;ret=file='';do n=0 to txt.count-1;parse value strip(translate(txt.n,' ','9'x)) with key args ';' .;key=upper(strip(key));args=strip(args);l=l+1
if key='' then iterate;if find(cfg.texts,key)=0 then call Quit(11,'Unknown keyword "'key'" in' file 'at line' l);parse var key . 2 typ '_' name .;call Add_Cfg('system.txt.'lang'.'typ'.'name,args);end;return ret
